;;;;

(defpackage :nehe-tests
  (:use :stefil :common-lisp :gl :iterate :nehe :lib.chipmunk :cl-user))

(in-package :nehe-tests)

(stefil:in-root-suite)
(stefil:defsuite* test-all)
(stefil:defsuite test-gltypes)
(stefil:defsuite test-vector-math)
(stefil:defsuite test-chipmunk)
(stefil:defsuite test-observers)

(stefil:in-suite test-gltypes)

#|(stefil:deftest test-glpointer ()
  (let* ((ptr (dream::%gl-vector 4 3 2 1)))
    (stefil:is (eql (slot-value ptr 'dream::element-type) (type-of 4)))
    (stefil:is (eql (slot-value ptr 'dream::element-count) 4))
    (stefil:is (equalp (slot-value ptr 'dream::ivector) #(4 3 2 1)))
    (stefil:is (eql (slot-value ptr 'dream::dims) 4))
    (stefil:is (eql (dream::gl-vector-length ptr) 4))
    (stefil:is (eql (dream::gl-aref ptr 2) 2))
    (setf (dream::gl-aref ptr 2) 3)
    (stefil:is (eql (dream::gl-aref ptr 2) 3))))
|#

(stefil:in-suite test-chipmunk)

(stefil:deftest test-cpv ()
  (let* ((cpv1 (cp:cpv 40 80))
         (cpv2 (cp:cpv 1.0 2.0))
         (cpv3 (cp:cpv 2.0d0 1.0d0))
         (cpv4 (cp:cpv 3 3)))
    (stefil:is (and (= (cp:cpv.x cpv1) 40.0d0)
                    (= (cp:cpv.y cpv1) 80.0d0)))
    (stefil:is (not (cp:cpv= cpv1 cpv2)))
    (stefil:is (cp:cpv= (cp:cpv+ cpv2 cpv3) cpv4))
    (stefil:is (cp:cpv= (cp:cpvneg cpv4) (cp:cpv -3 -3)))
    (stefil:is (cp:cpv= (cp:cpv- cpv4 (cp:cpv+ cpv2 cpv3)) cp:+cpvzero+))
    (stefil:is (cp:cpv= (cp:cpv* cpv2 2) (cp:cpv 2 4)))
    (stefil:is (= (cp:cpvdot cpv2 cpv3) 4.0d0))))

(stefil:deftest test-body ()
  (let ((bod (make-instance 'cp:body :mass 1.0 :moment 1.0 :position cp:+cpvzero+)))
    (stefil:is (= (cp:mass bod) 1.0d0)
               (= (cp:moment bod) 1.0d0)
               (= (cp:pos bod) cp:+cpvzero+))))
    
(stefil:deftest test-sim ()
  (let* ((bod (make-instance 'cp:body :mass 1.0 :moment 1.0 :position (cp:cpv 0 100)))
         (circ (make-instance 'cp:circle-shape :body bod :radius 10.0 :offset cp:+cpvzero+ :name "Circle"))
         (sbod (make-instance 'cp:body :mass cp:+infinity+ :moment cp:+infinity+))
         (floor (make-instance 'cp:segment-shape :body sbod :start (cp:cpv -10 0) :end (cp:cpv 10 0) :thickness 1))
         (space (make-instance 'cp:space :gravity (cp:cpv 0 -100))))
    (flet ((report-pos (object)
             (format t "~A at (~A, ~A)~%" (cp:name object) (cp:cpv.x (cp:pos object)) (cp:cpv.y (cp:pos object)))))
      (cp:add-static-object space sbod)
      (cp:add-static-object space floor)
      (cp:add-object space bod)
      (cp:add-object space circ)
      (report-pos circ)
      (cp:step-simulation space 60)
      (report-pos circ)
      (dotimes (i 100)
        (cp:step-simulation space 60)
        (report-pos circ)))))


(stefil:in-suite test-observers)


(stefil:deftest test-kvc-types ()
  (format t "~A~%" (lisp->kvc-compliant 2))
  (format t "~A~%" (lisp->kvc-compliant 1))
  (format t "~A~%" (lisp->kvc-compliant 102938))
  (format t "~A~%" (lisp->kvc-compliant 2.0))
  (format t "~A~%" (lisp->kvc-compliant 2.0d0))
  (format t "~A~%" (lisp->kvc-compliant "I am KVC compliant!"))
  (format t "~A~%" (lisp->kvc-compliant #\A))
  (format t "~A~%" (lisp->kvc-compliant 'lisp-symbol))
  (format t "~A~%" (lisp->kvc-compliant '(a b c d e)))
  (format t "~A~%" (lisp->kvc-compliant (list 'a 'b 'c (list 'd 'e)))))

(stefil:deftest test-kvc-properties ()
  (let ((kvc (make-instance 'kvc-implementor))
	(sub-kvc (make-instance 'sub-kvc-implementor)))
    (format t "Prop = ~A~%" (#/valueForKey: kvc #@"prop"))
    (format t "Ivar = ~A~%" (#/valueForKey: kvc #@"num"))
    (#/setValue:forKey: kvc (#/numberWithInt: ns:ns-number 25) #@"prop")
    (#/setValue:forKey: kvc (#/numberWithInt: ns:ns-number 3) #@"num")
    (format t "After setValue:forKey:, Prop = ~A, Ivar = ~A~%" 
	    (#/valueForKey: kvc #@"prop")
	    (#/valueForKey: kvc #@"num"))
    (setf (dashed-property kvc) sub-kvc)
    (format t "dashedProperty = ~A~%" (#/valueForKey: kvc #@"dashedProperty"))
    (format t "Value = ~A~%" (#/valueForKey: (#/valueForKey: kvc #@"dashedProperty") #@"value"))
    (format t "Dotted property = ~A~%" (#/valueForKeyPath: kvc #@"dashedProperty.value"))))


#|
(stefil:in-suite test-vector-math)

(stefil:deftest test-quaternions ()
  (let* ((quat (dream::%gl-vector 0.0 0.0 0.0 1.0))
	 (not-quat (dream::%gl-vector 1.0 1.0 1.0))
	 (rot-matrix (dream::identity-matrix)))
    (stefil:is (typep quat 'quaternion))
    (stefil:is (not (typep not-quat 'quaternion)))
    (stefil:is ())


(stefil:deftest test-vectors ()
  ;; Just call all the functions and make sure Lisp doesn't dump.
  (let* ((vec0 (zero-vector 3))
	 (vec-x (unit-x-vector))
	 (vec-y (unit-y-vector))
	 (vec-z (unit-z-vector))
	 (vec-sum (%gl-vector 1.0 1.0 1.0))
	 (vec-w (unit-w-vector)))
    (stefil:is (vector= vec-x (unit-x-vector)))
    (stefil:is (not (vector= vec-x vec0)))
    (stefil:is (vector3-p vec0))
    (stefil:is (not (vector2-p vec0)))
    (stefil:is (= (dream::x vec-x) 1.0))
    (stefil:is (= (dream::y vec-y) 1.0))
    (stefil:is (= (dream::z vec-z) 1.0))
    (setf (dream::x vec0) 1.0)
    (setf (dream::y vec0) 1.0)
    (setf (dream::z vec0) 1.0)
    (stefil:is (vector= vec0 vec-sum))
    (stefil:is (vector= (m+ vec-x vec-y vec-z) vec-sum))
    (stefil:is (vector= (m- vec-sum vec-sum) (zero-vector 3)))
    (stefil:is (vector= (m* 3.0 vec-sum) (%gl-vector 3.0 3.0 3.0)))
    (stefil:is (vector= (m/ (%gl-vector 3.0 3.0 3.0) 3.0) vec-sum))
    (stefil:is (vector= (mneg (unit-x-vector)) (%gl-vector -1.0 0.0 0.0)))
    (stefil:is (= (magnitude (%gl-vector 2.0 2.0)) (sqrt 8.0)))
    (stefil:is (= (squared-magnitude (%gl-vector 2.0 2.0)) 8.0))
    (stefil:is (= (dot-product (%gl-vector 1.0 1.0 1.0)
			       (%gl-vector 1.0 1.0 1.0))
		  3.0))
    (let* ((vec2d (%gl-vector 1.0 0.0))
	   (vec2d-perp (dream::perp vec2d)))
      ;; Using Pythagoras formula to test if two vectors are perpendicular.
      (stefil:is (= (+ (squared-magnitude vec2d) (squared-magnitude vec2d-perp))
		    (squared-magnitude (m- vec2d vec2d-perp)))))
    (stefil:is (vector= (normalize (%gl-vector 1.0 0.0 1.0))
			(%gl-vector (/ 1 (sqrt 2)) 0.0 (/ 1 (sqrt 2)))))
    (stefil:is (vector= (cross (unit-x-vector) (unit-y-vector)) (unit-z-vector)))
    (stefil:is (vector= (cross (%gl-vector 2.0 1.0 -1.0)
			       (%gl-vector -3.0 4.0 1.0))
			(%gl-vector 5.0 1.0 11.0)))
    (multiple-value-bind (u0 u1 u2) (orthonormalize (%gl-vector 1.0 0.0 1.0)
						    (%gl-vector 1.0 0.0 0.0)
						    (%gl-vector 2.0 1.0 0.0))
      (stefil:is (vector= u0 (m/ (%gl-vector 1.0 0.0 1.0)
				 (sqrt 2.0))))
      (stefil:is (vector= u1 (m/ (%gl-vector 1.0 0.0 -1.0)
				 (sqrt 2.0))))
      (stefil:is (vector= u2 (m/ (%gl-vector 0.0 1.0 0.0)))))))

|#